home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / sound / fixaiff_jf / fixaiff.jf < prev    next >
Text File  |  1999-05-17  |  6KB  |  224 lines
  1. \ FixAIFF V1.1
  2.  
  3. \ Forth Program JForth Professional V3.1.
  4. \ by Bob Dickow (dickow@uidaho.edu)
  5. \
  6. \ ...some AIFFs won't work in some programs
  7. \ such as Petsoff's DelFX player/recorder
  8. \ for the Delfina card. The problem is a
  9. \ simple one: The variables in the SSND
  10. \ chunk header (before the sample data) is
  11. \ sometimes set, but DelFX (up to v 1.02 so
  12. \ far to date) needs them to be zeros.
  13.  
  14. \ To use this program, simply call it from
  15. \ the shell, with the first parameter as
  16. \ the source sample file (AIFF) and the
  17. \ second parameter as the target file. The
  18. \ target is a new file with the modifications
  19. \ needed. The source file is untouched.
  20.  
  21. \ includes:
  22.  
  23. \ include? DEBUG{ jdev:debugger
  24. include? clone cl:topfile
  25. include? iff.check  jiff:IFF_Support
  26. \ you will need to declare 'AIFF' 'COMM' and 'SSND'
  27. \ in jiff:iff.j
  28.  
  29. \ the following is available from the JForth web
  30. \ site's user contributed code page. I wrote it!
  31. \ It parses command line arguments, like C, sort of.
  32. \ the site is at http:home.tampabay.rr.com/jforth/
  33. include? carg ju:parsecli
  34.  
  35. ANEW Task-FixAIFF
  36.  
  37. 256 constant buffsize
  38.  
  39. : NameFromFH() ( fh buffer -- err ) \ specific to this prg.
  40.   1+ >abs buffsize
  41.   CALL dos_lib NameFromFH
  42. ;
  43.  
  44. VARIABLE IFFSourceHandle
  45. VARIABLE IFFTargetHandle
  46.  
  47. IFFSourceHandle off \ for safety
  48. IFFTargetHandle off \ for safety
  49.  
  50. 40960 constant SSNDbuffsize
  51.  
  52. create SourcePathName buffsize 2+ allot align
  53. create TargetPathName buffsize 2+ allot align
  54. create SourceNamebuff buffsize 2+ allot align
  55. create TargetNamebuff buffsize 2+ allot align
  56.  
  57. DEFER SAVED-Iff.Process.chunk
  58. DEFER SAVED-Iff.process.Form
  59.  
  60. \ general exit routine, normal or when in error:
  61.  
  62. : FixEXIT  ( $EXITMSG -- )
  63.   count type cr
  64.   What's SAVED-IFF.Process.Chunk is IFF.Process.Chunk
  65.   What's SAVED-Iff.process.Form is IFF.process.form
  66.   IFF.Close
  67.   IFFTargetHandle @ ?dup if dup FCLOSE off then
  68.   IFFSourceHandle @ ?dup if dup FCLOSE off then
  69.   Abort
  70. ;
  71.  
  72.  
  73. \ strips quotes, if needed, from command line arguments:
  74.  
  75. : stripquotes  ( addr count buffer -- )
  76.   dup dup off >r
  77.   $append
  78.   r@ 1+ c@ ascii " = if \ it's a quoted string, so strip
  79.     r@ 2+ r@ 1+ r@ c@ 1- cmove r@ dup c@ 2- swap c!
  80.   then
  81.   rdrop
  82. ;
  83.  
  84. VARIABLE DATASIZE
  85.  
  86.  
  87. \ writes out string or numeric data to the target.
  88.  
  89. : write.target ( addr count -- )
  90.   IFFTargetHandle @ -rot
  91.   dup
  92.   >r FWRITE r> - if
  93.     " Error Writing Target AIFF" FixEXIT
  94.   then
  95. ;
  96.  
  97. : $>target ( stringaddr -- )
  98.   count write.target
  99. ;
  100.  
  101. VARIABLE BUFF
  102.  
  103. : n>target ( n -- )
  104.   BUFF ! BUFF CELL write.target
  105. ;
  106.  
  107. \ iff handling routines:
  108.  
  109. : iff.handle.AIFF ( size -- )
  110.   " FORM" $>target n>target " AIFF" $>target
  111. ;
  112.  
  113. : iff.handle.COMM { size | data -- }
  114.   size iff.read.data ?dup if
  115.     -> data
  116.     \ do stuff...
  117.       " COMM" $>target size n>target
  118.        data size write.target
  119.     \
  120.     data freeblock
  121.   else
  122.     drop
  123.   then
  124. ;
  125.  
  126. : iff.handle.SSND { size | data total -- }
  127.    size 8 - -> total
  128.    " SSND" $>target size n>target \ write out chunk id
  129.    0 n>target 0 n>target  \ write out eight zeros.
  130.    iff.where 8 + iff.seek
  131.    Begin
  132.      total SSNDBuffsize < if total else SSNDBuffsize then dup >r  \ size set for allocation
  133.      iff.read.data ?dup if
  134.        -> data
  135.        data r@ write.target
  136.        data freeblock
  137.      else
  138.        rdrop " File Read Error" FixEXIT
  139.      then
  140.      total r> - -> total
  141.    total 0= until
  142. ;
  143.  
  144. : My.IFF.HANDLE.FORM ( size -- , scan chunks in FORM )
  145.     1 iff-nested +!
  146.     iff.read.type  'AIFF' = if-not " Not an AIFF FORM!" FixEXIT  else
  147.     dup Iff.Handle.AIFF
  148.   then   \ drop \ .chkid cr
  149.     4 - ( subtract 4 for type )
  150.     BEGIN
  151.         dup 0>
  152.         iff-stop @ 0= AND  \ check for stop 00002
  153.     WHILE iff.scan 8 + ( account for header) -
  154.     REPEAT drop
  155.     -1 iff-nested +!
  156. ;
  157.  
  158. : My.Iff.Process.Chunk ( size chkid -- )
  159.    dup 'FORM' = if
  160.      drop
  161.      iff.process.FORM
  162.    else
  163.       dup 'COMM' = if
  164.         drop
  165.         iff.handle.COMM
  166.        else
  167.          'SSND' = if
  168.            iff.handle.SSND
  169.          else
  170.            drop
  171.          then
  172.        then
  173.    then
  174. ;
  175.  
  176. \ called routine. Call from CLI.
  177. : Run ( -- )
  178.   IFFSourceHandle off
  179.   IFFTargetHandle off
  180.   0" $VER: fixaiff V1.1 (5.1.99)" drop \ store version info for AmigaDOS
  181.   NCARG 2 = not if ." USAGE: fixaiff <sourceaiff> <targetaiff>" 
  182.     cr ." <sourceaiff> = aiff file to process." cr
  183.     ." <targetaiff> = file name for fixed aiff file." cr
  184.     " WARNING: <targetaiff> will be overwritten if it already exists."
  185.     FixEXIT
  186.   then
  187. \ these two lines parse the file names from the cli arguments:
  188.   1 CARG SourcePathName stripquotes
  189.   2 CARG TargetPathName stripquotes
  190.   \ check for same filename in same directory:
  191.   OLD
  192.   TargetPathName $FOPEN  ?dup if 
  193.     dup IFFTargetHandle !
  194.     TargetNamebuff NameFromFH() if-not " Error: Target pathname too long?" FixEXIT then
  195.   else
  196.     TargetNamebuff off
  197.   then
  198.   OLD
  199.   SourcePathName $FOPEN  ?dup if IFFSourceHandle ! else " Error opening source aiff." FixEXIT then
  200.   IFFSourceHandle @ SourceNamebuff NameFromFH() if-not " Error: Source pathname too long?" FixEXIT then
  201.   SourceNameBuff 0count TargetNameBuff 0count -rot -rot max
  202.   COMPARE if-not " ERROR: Sourceaiff = Targetaiff" FixEXIT then
  203.   \ All is ok, so proceed...
  204.   \ close the tested files first, if they're open:
  205.   IFFSourceHandle @ ?dup if FCLOSE IFFSourceHandle off then
  206.   IFFTargetHandle @ ?dup if FCLOSE IFFTargetHandle off then
  207.   \ check to see if the sourceaiff is a real iff file:
  208.   What's Iff.Process.Chunk  is SAVED-Iff.Process.chunk
  209.   What's Iff.Process.Form   is SAVED-Iff.Process.Form
  210.   'C My.Iff.Process.Chunk is IFF.Process.Chunk
  211.   'C My.Iff.Handle.Form is IFF.Process.FORM
  212.   NEW
  213.   TargetPathName $FOPEN  ?dup if IFFTargetHandle ! else " Error opening target " FixEXIT then
  214.   OLD
  215.   SourcePathName $Iff.DoFile? if " Error opening source aiff." FixEXIT then
  216.   " OK" FixEXIT
  217. ;
  218.  
  219. \ END FixAIFF file
  220.  
  221.  
  222.  
  223.  
  224.